home *** CD-ROM | disk | FTP | other *** search
/ Internet.Works 39 / Issue 39.iso / pc / PCSoftware / VRML Pad / vpadinst.exe / SAMPLE.BAS < prev    next >
Encoding:
BASIC Source File  |  2000-07-21  |  7.0 KB  |  262 lines
  1. '----------------------------------------------------------------------
  2. 'FILE DESCRIPTION: SAMPLE.VBS is a collection of sample VrmlPad macros.
  3. '----------------------------------------------------------------------
  4.  
  5. '------------------------------------------------------------
  6. 'Inserts all fields of the selected node with default values.
  7. '------------------------------------------------------------
  8.  
  9. BindCommand "Complete_All", "Inserts all fields of the node",, "Alt+C"
  10.  
  11. Sub Complete_All
  12.     Set ent = CurrentEntity
  13.     If ent Is Nothing Then Exit Sub
  14.     If ent.EntityType = vpNode Then
  15.         BeginOperation "Complete All"
  16.         For Each fld In ent.Fields
  17.             fld.Implicit = False
  18.         Next
  19.         EndOperation
  20.     End If
  21. End Sub
  22.  
  23. '-------------------------------------------------------
  24. 'Prompts for a node name and selects the specified node.
  25. '-------------------------------------------------------
  26.  
  27. Sub Go_To_Node
  28.     nn = InputBox("Enter a node name:")
  29.     If nn = "" Then Exit Sub
  30.     On Error Resume Next
  31.     Set node = Nodes(nn)
  32.     If node Is Nothing Then
  33.         Set node = CurrentContext.Nodes(nn)
  34.     End If
  35.     If node Is Nothing Then
  36.         MsgBox "Can't find the node '" + nn + "'"
  37.     Else
  38.         node.Range(vprnName).Select
  39.     End If
  40. End Sub
  41.  
  42. '-----------------------------------------------------------------
  43. 'Enumerates all faces in the document and in the selected faceset.
  44. '-----------------------------------------------------------------
  45.  
  46. BindCommand "Count_Faces", "Enumerates all faces", "Count &Faces..."
  47. BindPopup "Count_Faces", "Count &Faces...", "IndexedFaceSet, IndexedFaceSet.*"
  48.  
  49. Function FacesInFaceset (fs)
  50.     count = 0
  51.     newface = True
  52.     For Each ind In fs("coordIndex").Value
  53.         If ind < 0 Then
  54.             newface = True
  55.         ElseIf newface Then
  56.             count = count + 1
  57.             newface = False
  58.         End If
  59.     Next
  60.     FacesInFaceset = count
  61. End Function
  62.  
  63. Sub Count_Faces
  64.     count = 0
  65.     For Each fs In StdProtos("IndexedFaceSet").Instances
  66.         count = count + FacesInFaceset(fs)
  67.     Next
  68.     str = "Total " & count & " faces"
  69.  
  70.     Set ent = CurrentEntity
  71.     Do Until ent Is Nothing
  72.         If ent.EntityType = vpNode Then
  73.             If ent.TypeName = "IndexedFaceSet" Then
  74.                 str = str & vbCrLf & FacesInFaceset(ent)
  75.                 str = str + " in the selected faceset"
  76.                 Exit Do
  77.             End If
  78.         End If
  79.         Set ent = ent.Owner
  80.     Loop
  81.     MsgBox str
  82. End Sub
  83.  
  84. '------------------------------------------------------------
  85. 'Wraps the selected node by Group, Transform or Anchor nodes.
  86. '------------------------------------------------------------
  87.  
  88. Sub WrapNodeBy (env)
  89.     Set node = CurrentEntity
  90.     If node Is Nothing Then Exit Sub
  91.     If node.EntityType <> vpNode And _
  92.         node.EntityType <> vpNodeRef Then Exit Sub
  93.     Set owner = node.Owner
  94.     If owner Is Nothing Then
  95.         Set coll = RootNodes
  96.     ElseIf owner.EntityType = vpProto Then
  97.         Set coll = owner.RootNodes
  98.     ElseIf (owner.EntityType = vpField Or _
  99.             owner.EntityType = vpFieldDecl) And _
  100.             owner.Type = vpfMFNode Then
  101.         Set coll = owner.Value
  102.     Else
  103.         MsgBox "Can't wrap this node"
  104.         Exit Sub
  105.     End If
  106.     BeginOperation "Wrap Node"
  107.     Dim nn
  108.     nn = node.name
  109.     Set group = coll.Add(env, node.Range)("children")
  110.     group.Add node
  111.     node.DeleteInstance
  112.     Set node = group(group.Count)
  113.     If node.EntityType = vpNode Then node.name = nn
  114.     EndOperation
  115. End Sub
  116.  
  117. BindCommand "WrapNodeByGroup", "Wraps the selected node by Group", "&Wrap by|&Group"
  118.  
  119. Sub WrapNodeByGroup
  120.     WrapNodeBy("Group")
  121. End Sub
  122.  
  123. BindCommand "WrapNodeByTransform", "Wraps the selected node by Transform", "&Wrap by|&Transform"
  124.  
  125. Sub WrapNodeByTransform
  126.     WrapNodeBy("Transform")
  127. End Sub
  128.  
  129. BindCommand "WrapNodeByAnchor", "Wraps the selected node by Anchor", "&Wrap by|&Anchor"
  130.  
  131. Sub WrapNodeByAnchor
  132.     WrapNodeBy("Anchor")
  133. End Sub
  134.  
  135. '------------------------------------------------------
  136. 'Converts Box, Cone or Cylinder node to IndexedFaceSet.
  137. '------------------------------------------------------
  138.  
  139. BindCommand "ConvertToFaceset", "Converts Box, Cone or Cylinder to IndexedFaceSet", "To Face&set"
  140. BindPopup "ConvertToFaceset", "Convert To Face&set", "Box, Cone, Cylinder"
  141.  
  142. Sub Box2Faceset (ByVal node, ByRef coord, ByRef index)
  143.     size = node("size")
  144.     ReDim coord(7,2)
  145.     For i = 0 To 7
  146.         coord(i, 0) = (.5 - (i And 4)/4) * size.x
  147.         coord(i, 1) = (.5 - (i And 2)/2) * size.y
  148.         coord(i, 2) = (.5 - (i And 1)) * size.z
  149.     Next
  150.     index = Array(4,0,1,5,-1, 7,3,2,6,-1, 6,2,0,4,-1,_
  151.                   2,3,1,0,-1, 3,7,5,1,-1, 7,6,4,5)
  152. End Sub
  153.  
  154. Sub Cone2Faceset (ByVal node, ByRef coord, ByRef index)
  155.     Const n = 20
  156.     h = node("height")/2
  157.     r = node("bottomRadius")
  158.     side = node("side")
  159.     bottom = node("bottom")
  160.     If bottom Then k = n Else k = 0
  161.     If side Then t = k+4*n Else t = k
  162.     ReDim coord(n,2)
  163.     ReDim index(t-1)
  164.     coord(n, 1) = h
  165.     For i = 0 To n-1
  166.         ang = 2*3.141592*i/n
  167.         coord(i, 0) = r * Cos(ang)
  168.         coord(i, 2) = r * Sin(ang)
  169.         coord(i, 1) = -h
  170.         If bottom Then index(i) = i
  171.         If side Then
  172.             index(k+4*i) = -1
  173.             index(k+4*i+1) = i
  174.             index(k+4*i+2) = i-1
  175.             index(k+4*i+3) = n
  176.         End If
  177.     Next
  178.     If side Then index(k+2) = n-1
  179. End Sub
  180.  
  181. Sub Cylinder2Faceset (ByVal node, ByRef coord, ByRef index)
  182.     Const n = 20
  183.     h = node("height")/2
  184.     r = node("radius")
  185.     side = node("side")
  186.     top = node("top")
  187.     bottom = node("bottom")
  188.     If side Then k = 5*n Else k = 0
  189.     If top Then m = k+n+1 Else m = k
  190.     If bottom Then t = m+n Else t = m
  191.     ReDim coord(2*n,2)
  192.     ReDim index(t-1)
  193.     For i = 0 To n-1
  194.         ang = 2*3.141592*i/n
  195.         coord(i, 0) = r * Cos(ang)
  196.         coord(i, 2) = r * Sin(ang)
  197.         coord(i, 1) = -h
  198.         coord(i+n, 0) = coord(i, 0)
  199.         coord(i+n, 2) = coord(i, 2)
  200.         coord(i+n, 1) = h
  201.         If side Then
  202.             index(5*i) = i
  203.             index(5*i+1) = i-1
  204.             index(5*i+2) = n+i-1
  205.             index(5*i+3) = n+i
  206.             index(5*i+4) = -1
  207.         End If
  208.         If top Then index(k+i) = 2*n-i-1
  209.         If bottom Then index(m+i) = i
  210.     Next
  211.     If side Then
  212.         index(1) = n-1
  213.         index(2) = 2*n-1
  214.     End If
  215.     If top Then index(k+n) = -1
  216. End Sub
  217.  
  218. Sub ConvertToFaceset
  219.     Dim coord
  220.     Dim index
  221.     Set node = CurrentEntity
  222.     If Not node Is Nothing Then
  223.         If node.EntityType = vpNode Then
  224.             If node.TypeName = "Box" Then
  225.                 Box2Faceset node, coord, index
  226.             ElseIf node.TypeName = "Cone" Then
  227.                 Cone2Faceset node, coord, index
  228.             ElseIf node.TypeName = "Cylinder" Then
  229.                 Cylinder2Faceset node, coord, index
  230.             End If
  231.         End If
  232.     End If
  233.     If Not IsArray(index) Then
  234.         MsgBox "Please, select Box, Cone or Cylinder node"
  235.         Exit Sub
  236.     End If
  237.     If node.References.Count > 0 Or _
  238.             node.InRoutes.Count  > 0 Or _
  239.             node.OutRoutes.Count > 0 Then
  240.         If MsgBox("All references to the node will be deleted. Continue?",_
  241.             vbOKCancel) = vbCancel Then Exit Sub
  242.     End If
  243.     Set owner = node.Owner
  244.     If Not owner Is Nothing Then
  245.         If owner.EntityType = vpField Then
  246.             If owner.Type = vpfSFNode Then
  247.                 BeginOperation "Convert to Faceset"
  248.                 owner.Value = "IndexedFaceSet"
  249.                 Set node = owner.Value
  250.                 node("colorPerVertex") = False
  251.                 node("creaseAngle") = 1
  252.                 node("coord") = "Coordinate"
  253.                 node("coord")("point") = coord
  254.                 node("coordIndex") = index
  255.                 EndOperation
  256.                 Exit Sub
  257.             End If
  258.         End If
  259.     End If
  260.     MsgBox "Must be in a Shape node"
  261. End Sub
  262.